home *** CD-ROM | disk | FTP | other *** search
/ Softdisk G-S 93 / SGDS 93.2mg / SDGS.93 / SDA93 / A / M.GRAPH.DRAW (.txt) < prev    next >
Encoding:
Applesoft BASIC Source Code  |  1989-05-22  |  8.2 KB  |  306 lines  |  [FC] Applesoft BASIC Program (0x0801)
  1. 10  INVERSE 
  2. 20  ONERR  GOTO 55000
  3. 2000  REM ======
  4. 2010  REM Graphs
  5. 2020  REM ======
  6. 2030  CALL BOX,3,5,38,20
  7. 2040 O$(1) = "to screen":O$(2) = O$(1):O$(3) = O$(1):O$(4) = O$(1)
  8. 2050  IF OP$(1) = "Yes"  THEN O$(1) = "to text file":O$(2) = "to single-res pic":O$(3) = O$(2):O$(4) = O$(2)
  9. 2060  IF OP$(2) = "Yes, to slot "  THEN O$(1) = "to all printers":O$(2) = "to Imagewriter only":O$(3) = O$(2):O$(4) = O$(2)
  10. 2070  PRINT "   Graphs"
  11. 2080  PRINT 
  12. 2090  PRINT "1. Bar: Stars "O$(1)
  13. 2100  PRINT "2. Bar: Bars "O$(2)
  14. 2110  PRINT "3. Pie "O$(3)
  15. 2120  PRINT "4. Line "O$(4)
  16. 2130  PRINT "5. Exit"
  17. 2140 PR$ = " Press the number of your choice.": GOSUB 50000
  18. 2150  GET K$
  19. 2160  IF K$ = ES$  THEN 2210
  20. 2170  IF   NOT  VAL(K$)  THEN  GOSUB 51000: GOTO 2140
  21. 2180 M2 =  VAL(K$): IF M2 >5  THEN  GOSUB 51000: GOTO 2140
  22. 2190  ON M2 GOSUB 21000,21000,22000,23000
  23. 2200  IF M2 = 5  THEN 2210
  24. 2210  ONERR  GOTO 10000
  25. 2220  CALL BOX,11,10,18,3: PRINT "   One moment...": PRINT  CHR$(4)"CHAIN M.GRAPH.MAIN"
  26. 10000  CALL  -3288
  27. 10010  POKE 216,0
  28. 10020  CALL BOX,5,5,30,15: PRINT : PRINT "          FATAL ERROR."
  29. 10030  PRINT : PRINT "     Missing a module."
  30. 10040  PRINT : PRINT "  Press a key to exit."
  31. 10050  GET K$
  32. 10060  POKE 104,8: GOTO 150
  33. 10070  CALL  -3288
  34. 10072  TEXT : HOME 
  35. 10080  POKE 216,0: NORMAL 
  36. 10100  PRINT : PRINT "  CANNOT PRINT TO SELECTED SLOT.": PRINT 
  37. 10120  PRINT "    PRESS A KEY."
  38. 10130  GET K$: CALL 2304: POKE 48688, PEEK(0): POKE 48689, PEEK(1): INVERSE 
  39. 10140  GOTO 2210
  40. 21000  REM =========
  41. 21010  REM Bar Graph
  42. 21020  REM =========
  43. 21030  IF BQ$(1) = ""  THEN PR$ = " No data to graph.  Press a key. ": GOSUB 50000: GOSUB 51000: GET K$: GOTO 21440
  44. 21040 BO$ = "*": IF M2 = 2  THEN BO$ = " ": REM  bar output: star or bar
  45. 21050  PRINT  CHR$(20) CHR$(12);: REM   Text:home
  46. 21060  IF OP$(1) = "Yes"  THEN  GOSUB 21450: IF EX  THEN 21440
  47. 21070  ONERR  GOTO 10070
  48. 21080  IF OP$(2) = "Yes, to slot "  AND M2 < >2  THEN  GOSUB 53000: PRINT  CHR$(4)"PR#"PR
  49. 21090  POKE 216,0
  50. 21100  IF M2 = 2  THEN  PRINT  CHR$(20) CHR$(12);
  51. 21110 ID =  LEN(B9$): IF  LEN(B9$) < LEN(B0$)  THEN ID =  LEN(B0$): REM   indentation
  52. 21120 ID = ID +1:NI = 0: REM   number of items
  53. 21130  FOR T = 0 TO 15
  54. 21140  IF BQ$(T) = ""  THEN NI = T -1:T = 16
  55. 21150  NEXT 
  56. 21160 T8 = 0: FOR T9 = 0 TO NI:T8 = T8 + VAL(BQ$(T9)): NEXT :AV = T8/(NI +1): REM average
  57. 21170  PRINT BU$; SPC( 38 - LEN(BT$) - LEN(BU$));BT$
  58. 21180 B9 =  INT( VAL(B9$)):B0 =  INT( VAL(B0$))
  59. 21190  FOR T1 = B9 TO B0  STEP  -(B9 -B0)/20
  60. 21200  PRINT  SPC( ID - LEN( STR$( INT(T1)))); INT(T1);
  61. 21210  PRINT "|";
  62. 21220  FOR T = 0 TO NI
  63. 21230  IF  VAL(BQ$(T)) > = T1  THEN  NORMAL : PRINT BO$;: INVERSE : PRINT " ";: GOTO 21250
  64. 21240  PRINT "  ";
  65. 21250  NEXT T
  66. 21260  IF BA$ = "Y"  OR BA$ = "y"  THEN  IF AV > = T1  THEN  NORMAL : PRINT BO$;: INVERSE 
  67. 21270  PRINT : IF NX  THEN 21282
  68. 21280  NEXT T1
  69. 21282 NX = 0
  70. 21286  IF  PEEK(37) = 21  THEN T1 = B0:NX = 1: GOTO 21200
  71. 21290  PRINT  SPC( ID)
  72. 21300  PRINT  LEFT$(" -----------------------------------",39 -ID)
  73. 21310  PRINT  SPC( ID +1)
  74. 21320  FOR T = 0 TO NI
  75. 21330  PRINT  CHR$(65 +T)" ";
  76. 21340  NEXT 
  77. 21350  IF BA$ = "Y"  OR BA$ = "y"  THEN  PRINT "Av"
  78. 21360  PRINT  CHR$(4)"close": REM   close for file output in case
  79. 21370  ONERR  GOTO 10070
  80. 21380  IF OP$(2) = "Yes, to slot "  AND M2 = 2  THEN  GOSUB 53000: PRINT  CHR$(4)"PR#"PR: PRINT  CHR$(27)"e";: POKE 24579,255: POKE 24580,1: CALL 24576
  81. 21390  ONERR  GOTO 55000
  82. 21400  IF OP$(1) = "Yes"  AND M2 = 2  THEN  PRINT  CHR$(4)"BSAVE"FI$",A$4000,L$2000":PR$ = "  Done saving. Press a key. ": GOSUB 50000
  83. 21410  IF OP$(2) = "Yes, to slot "  THEN  PRINT  CHR$(12);: PRINT  CHR$(4)"PR#0": CALL 2304: POKE 48688, PEEK(0): POKE 48689, PEEK(1)
  84. 21420  IF OP$(1) = "Yes"  OR OP$(2) = "Yes, to slot "  THEN PR$ = "         Press a key.         ": GOSUB 50000
  85. 21425  POKE 216,0
  86. 21430  GET K$
  87. 21440  RETURN 
  88. 21450  REM ==============
  89. 21460  REM Output to File
  90. 21470  REM ==============
  91. 21480  CALL BOX,1,1,40,24
  92. 21490  PRINT : PRINT "Save graph in what file?"
  93. 21500 PR$ = "Type a filename. Press RETURN.": GOSUB 50000
  94. 21510 IN$ = DFAULTPTH$
  95. 21520  IF  RIGHT$(IN$,1) = " "  THEN IN$ =  LEFT$(IN$, LEN(IN$) -1): GOTO 21520
  96. 21530 H = 2:V = 5:W = 15:L = 64: GOSUB 54000
  97. 21540 EX = 0: IF IN$ = ""  THEN EX = 1: GOTO 21600
  98. 21550 FI$ = IN$
  99. 21560  IF M2 = 2  THEN 21600
  100. 21570  PRINT : HTAB 4: PRINT "Writing....";
  101. 21580  PRINT  CHR$(4)"open"FI$
  102. 21590  PRINT  CHR$(4)"write"FI$
  103. 21600  RETURN 
  104. 22000  REM =========
  105. 22010  REM Pie Graph
  106. 22020  REM =========
  107. 22030  IF PQ$(1) = ""  THEN PR$ = " No data to graph.  Press a key. ": GOSUB 50000: GOSUB 51000: GET K$: GOTO 22390
  108. 22040  PRINT  CHR$(20) CHR$(12);: REM   Text:home
  109. 22050  IF OP$(1) = "Yes"  THEN  GOSUB 22400: IF EX  THEN 22390
  110. 22060 ID = ID +1:NI = 0: REM   number of items
  111. 22070  FOR T = 0 TO 15
  112. 22080  IF PQ$(T) = ""  THEN NI = T -1:T = 16
  113. 22090  NEXT 
  114. 22100 T8 = 0: FOR T9 = 0 TO NI:T8 = T8 + VAL(PQ$(T9)): NEXT : REM TOTAL
  115. 22110  HTAB 39 - LEN(PT$): PRINT PT$
  116. 22120  HCOLOR= 0: HPLOT 90,170
  117. 22130  FOR T = 0 TO 6.4  STEP .07
  118. 22140  HPLOT  TO 90 -80 *( SIN(T)),90 +80 *( COS(T))
  119. 22150  NEXT T
  120. 22160  HPLOT 90,90 TO 90,170
  121. 22170 RT = 0: REM PIELINE ROTATION
  122. 22180 RL = 0: REM LETTER ROTATION 
  123. 22190  FOR T = 0 TO NI -1
  124. 22200 RL = RT +6.28 * VAL(PQ$(T))/2/T8
  125. 22210 RT = RT +6.28 * VAL(PQ$(T))/T8
  126. 22220  HPLOT 90,90 TO 90 -80 *( SIN(RT)),90 +80 *( COS(RT))
  127. 22230  DRAW T +34 AT 90 -88 *( SIN(RL)),90 +88 *( COS(RL))
  128. 22240  NEXT T
  129. 22250 RL = RT +6.28 * VAL(PQ$(T))/2/T8
  130. 22260  DRAW T +34 AT 90 -88 *( SIN(RL)),90 +88 *( COS(RL))
  131. 22270  REM VTAB 23: HTAB 10: ? "< A  " CHR$ (T + 65)"<"
  132. 22280  REM HPLOT 107,179 TO 111,179: HPLOT 65,179 TO 69,179
  133. 22290  FOR T = 0 TO NI
  134. 22300 TZ = 4:TY = 2:TX = 0:TW = 100 * VAL(PQ$(T))/T8: GOSUB 57000
  135. 22310  VTAB 3 +T: HTAB 30: PRINT  CHR$(T +65)": "TW$"%"
  136. 22320  NEXT 
  137. 22330  IF OP$(1) = "Yes"  THEN  PRINT  CHR$(4)"BSAVE"FI$",a$4000,l$2000":PR$ = "  Done saving. Press a key. ": GOSUB 50000
  138. 22340  ONERR  GOTO 10070
  139. 22350  IF OP$(2) = "Yes, to slot "  THEN  GOSUB 53000: PRINT  CHR$(4)"PR#"PR: PRINT  CHR$(27)"e";: POKE 24579,255: POKE 24580,1: CALL 24576: PRINT  CHR$(12);: PRINT  CHR$(4)"PR#0": CALL 2304: POKE 48688, PEEK(0): POKE 48689, PEEK(1)
  140. 22360  POKE 216,0
  141. 22370  IF OP$(1) = "Yes"  OR OP$(2) = "Yes, to slot "  THEN PR$ = "         Press a key.         ": GOSUB 50000
  142. 22380  GET K$
  143. 22390  RETURN 
  144. 22400  REM  ==============
  145. 22410  REM  Output to File
  146. 22420  REM  ==============
  147. 22430  CALL BOX,1,1,40,24
  148. 22440  PRINT : PRINT "Save graph as what picture file?"
  149. 22450 PR$ = "Type a filename. Press RETURN.": GOSUB 50000
  150. 22452 IN$ = DFAULTPTH$
  151. 22454  IF  RIGHT$(IN$,1) = " "  THEN IN$ =  LEFT$(IN$, LEN(IN$) -1): GOTO 22454
  152. 22460 H = 2:V = 5:W = 15:L = 64: GOSUB 54000
  153. 22470 EX = 0: IF IN$ = ""  THEN EX = 1: GOTO 22490
  154. 22480 FI$ = IN$
  155. 22490  PRINT  CHR$(20) CHR$(12): RETURN 
  156. 23000  REM ==========
  157. 23010  REM Line Graph
  158. 23020  REM ==========
  159. 23030  IF LQ$(1) = ""  THEN PR$ = " No data to graph.  Press a key. ": GOSUB 50000: GOSUB 51000: GET K$: GOTO 23560
  160. 23040  HCOLOR= 0
  161. 23050  PRINT  CHR$(20) CHR$(12);: REM    Text:home
  162. 23060  IF OP$(1) = "Yes"  THEN  GOSUB 22400: IF EX  THEN 23560
  163. 23070  PRINT  CHR$(20) CHR$(12);
  164. 23080 ID =  LEN(L9$): IF  LEN(L9$) < LEN(L0$)  THEN ID =  LEN(L0$): REM    indentation
  165. 23090 ID = ID +1:NI = 0: REM    number of items
  166. 23100  FOR T = 0 TO 15
  167. 23110  IF LQ$(T) = ""  THEN NI = T -1:T = 16
  168. 23120  NEXT 
  169. 23130 :
  170. 23140  PRINT LU$; SPC( 38 - LEN(LT$) - LEN(LU$));LT$
  171. 23150 L9 =  INT( VAL(L9$)):L0 =  INT( VAL(L0$))
  172. 23160  IF L9 <L0  THEN T1 = L9:L9 = L0:L0 = T1: REM  swap if max/min wrong
  173. 23170  FOR T1 = L9 TO L0  STEP  -(L9 -L0)/20
  174. 23180  PRINT  SPC( ID - LEN( STR$( INT(T1)))); INT(T1);
  175. 23190 :
  176. 23200 :
  177. 23210 :
  178. 23220 :
  179. 23230 :
  180. 23240 :
  181. 23250  PRINT 
  182. 23260  NEXT T1
  183. 23270 VQ =  PEEK(37) *8 +3
  184. 23280  PRINT  SPC( ID)
  185. 23300  PRINT  LEFT$(" -----------------------------------",39 -ID)
  186. 23302  HPLOT ID *7 +2,9 TO ID *7 +2,VQ
  187. 23310  HPLOT ID *7 +2,VQ TO 279,VQ
  188. 23320  HPLOT ID *7 +2,VQ +1 TO 279,VQ +1
  189. 23330  PRINT  SPC( ID +1)
  190. 23340  FOR T = 0 TO NI
  191. 23350  PRINT  CHR$(65 +T)" ";
  192. 23360  NEXT 
  193. 23370 FA = 165/(L9 -L0)
  194. 23380 H1 = (ID +1.5) *7
  195. 23390  IF  VAL(LQ$(0)) >L9  THEN  HPLOT H1,10: GOTO 23420
  196. 23400  IF  VAL(LQ$(0)) <L0  THEN  HPLOT H1,175: GOTO 23420
  197. 23410  HPLOT H1,(L9 - VAL(LQ$(0))) *FA +10
  198. 23420 H1 = H1 +14
  199. 23430  FOR T1 = 1 TO NI
  200. 23440 :
  201. 23450  IF  VAL(LQ$(T1)) >L9  THEN  HPLOT  TO H1,10: GOTO 23480
  202. 23460  IF  VAL(LQ$(T1)) <L0  THEN  HPLOT  TO H1,175: GOTO 23480
  203. 23470  HPLOT  TO H1,(L9 - VAL(LQ$(T1))) *FA +10
  204. 23480 H1 = H1 +14
  205. 23490  NEXT 
  206. 23500  IF OP$(1) = "Yes"  THEN  PRINT  CHR$(4)"BSAVE"FI$",a$4000,l$2000":PR$ = "  Done saving. Press a key. ": GOSUB 50000
  207. 23510  ONERR  GOTO 10070
  208. 23520  IF OP$(2) = "Yes, to slot "  THEN  GOSUB 53000: PRINT  CHR$(4)"PR#"PR: PRINT  CHR$(27)"e";: POKE 24579,255: POKE 24580,1: CALL 24576: PRINT  CHR$(12);: PRINT  CHR$(4)"PR#0": CALL 2304: POKE 48688, PEEK(0): POKE 48689, PEEK(1)
  209. 23530  POKE 216,0
  210. 23540  IF OP$(1) = "Yes"  OR OP$(2) = "Yes, to slot "  THEN PR$ = "         Press a key.         ": GOSUB 50000
  211. 23550  GET K$
  212. 23560  RETURN 
  213. 50000  REM  ==========
  214. 50010  REM Prompt Box
  215. 50020  REM ==========
  216. 50030 W =  LEN(PR$) +2
  217. 50040  CALL BOX,40 -W,21,W,3
  218. 50050  PRINT PR$
  219. 50060  RETURN 
  220. 51000  REM ====
  221. 51010  REM Bell
  222. 51020  REM ====
  223. 51030  CALL  PEEK(121) + PEEK(122) *256 +28: REM  SPEED=   DEL <UNKNOWN TOKEN> SPEED= <CTRL-0x01> DEL <UNKNOWN TOKEN> SPEED= <CTRL-0x02><CTRL-0x18> HGR2 <CTRL-0x14> PLOT 0 TAB(  SPEED= <CTRL-0x02> DEL <UNKNOWN TOKEN> SPEED= $<CTRL-0x18> HGR2 <CTRL-0x08> PLOT 0 TAB(   NOT <UNKNOWN TOKEN> =  STR$`8H RIGHT$<CTRL-0x01> = <UNKNOWN TOKEN>h RIGHT$<CTRL-0x01> = <UNKNOWN TOKEN> ONERR <UNKNOWN TOKEN> -<CTRL-0x01><UNKNOWN TOKEN> RND =  VAL:`
  224. 51040  RETURN 
  225. 53000  REM ===============
  226. 53010  REM text print prmt
  227. 53020  REM ===============
  228. 53030  PRINT  CHR$(4)"PR#0"
  229. 53040  NORMAL : TEXT : HOME : VTAB 12: HTAB 12
  230. 53050  PRINT "PRINTING... PLEASE WAIT."
  231. 53052  IF M2 < >1  THEN  PRINT : PRINT  TAB( 12)" PRESS [ESC] TO CANCEL."
  232. 53055  INVERSE 
  233. 53060  RETURN 
  234. 54000  REM 
  235. 54010  REM ****************************
  236. 54020  REM *                          *
  237. 54030  REM * NAME:OK INPUT            *
  238. 54040  REM * PASS:V = VERT POSN       *
  239. 54050  REM * PASS:H = HORIZ POSN      *
  240. 54060  REM * PASS:W = WIDTH OF INPUT  *
  241. 54070  REM * PASS:L = LENGTH OF INPUT *
  242. 54080  REM * PASS:IN$ = DEFAULT INPUT *
  243. 54090  REM * USES:T$,T,T1,T2,T3,T4,IN$*
  244. 54100  REM * RETN:IN$                 *
  245. 54110  REM *                          *
  246. 54120  REM ****************************
  247. 54130  REM 
  248. 54140  VTAB V: HTAB H: POKE 32,H -1: POKE 33,W +1: PRINT : VTAB V: HTAB 1: PRINT IN$;:T1 =  PEEK(37) +1:T2 =  PEEK(36) +H: PRINT  CHR$(20);
  249. 54150 T3 = T2 -H:T4 =  LEN(IN$)
  250. 54160  HTAB T2: VTAB T1: PRINT " ": HTAB T2: VTAB T1: PRINT "_"
  251. 54170  IF  PEEK(49152) <128  THEN 54160
  252. 54180  GET T$: IF T$ =  CHR$(13)  THEN 54300
  253. 54190  IF T$ =  CHR$(24)  THEN  FOR T = 1 TO  LEN(IN$):T$ =  CHR$(8): GOSUB 54250: NEXT : GOTO 54160
  254. 54200  IF T$ =  CHR$(27)  THEN  FOR T = 1 TO  LEN(IN$):T$ =  CHR$(8): GOSUB 54250: NEXT : VTAB T1: HTAB T2: PRINT " ": GOTO 54300
  255. 54210  IF T$ =  CHR$(8)  OR T$ =  CHR$(127)  THEN  GOSUB 54250: GOTO 54160
  256. 54220  IF T$ <" "  OR T4 = L  THEN 54160
  257. 54230  VTAB T1: HTAB T2: PRINT T$;:IN$ = IN$ +T$:T2 = T2 +1:T4 = T4 +1:T3 = T3 +1: IF T3 >W  THEN T3 = 0:T2 = H:T1 = T1 +1
  258. 54240  GOTO 54160
  259. 54250  IF H = T2  THEN  IF V = T1  THEN  RETURN 
  260. 54260  IF  LEN(IN$) = 1  THEN IN$ = "": HTAB T2: VTAB T1: PRINT " ";:T2 = H:T1 = V:T4 = 0:T3 = 0: RETURN 
  261. 54270 IN$ =  LEFT$(IN$, LEN(IN$) -1): VTAB T1: HTAB T2: PRINT " ":T2 = T2 -1: IF T2 <H  THEN T2 = H +W:T1 = T1 -1
  262. 54280 T3 = T3 -1: IF T3 <0  THEN T3 = W
  263. 54290 T4 = T4 -1: PRINT  CHR$(4)"FRE": RETURN 
  264. 54300  HTAB T2: VTAB T1: PRINT " ": RETURN 
  265. 55000  REM =====
  266. 55010  REM error
  267. 55020  REM =====
  268. 55030  CALL  -3288
  269. 55040  POKE 216,0
  270. 55050 ER =  PEEK(222)
  271. 55060  CALL BOX,4,8,35,12
  272. 55070  PRINT 
  273. 55080  PRINT "       Oh, dear!"
  274. 55090  PRINT " Something didn't work!"
  275. 55100  PRINT 
  276. 55110  PRINT "Error "ER" in line " PEEK(218) + PEEK(219) *256
  277. 55120  IF ER = 16  THEN  PRINT "Probably a bad filename."
  278. 55130  IF ER = 4  THEN  PRINT "Disk is write protected."
  279. 55140  IF ER = 8  THEN  PRINT "I/O error!"
  280. 55150  IF ER = 9  THEN  PRINT "No space on disk."
  281. 55160  IF ER = 10  THEN  PRINT "Can't save over locked file."
  282. 55170  IF ER = 13  THEN  PRINT "Can't save over other file type."
  283. 55180  IF ER = 17  THEN  PRINT "Directory holds only 51 files."
  284. 55190  IF ER = 6  THEN  PRINT "Can't find the path you want."
  285. 55200  IF ER = 255  THEN  PRINT "You pressed ctrl-c."
  286. 55210  PRINT 
  287. 55220  PRINT " Press a key. Try again."
  288. 55230  GET K$
  289. 55240  GOTO 2210
  290. 57000  REM ========================
  291. 57010  REM   USING SUBROUTINE
  292. 57020 TV$ = "        ":TU$ = "00000000":TT$ = "********"
  293. 57030 TW$ =  STR$( INT((TW +(5/10 ^(TY +1))) *10 ^TY))
  294. 57040  IF  LEFT$(TW$,1) = "-"  THEN TW$ =  RIGHT$(TW$, LEN(TW$) -1)
  295. 57050  IF  LEN(TW$) >TZ  THEN TW$ =  LEFT$(TT$,TZ)
  296. 57060 TS = TY +1 - LEN(TW$): IF TS >0  THEN TW$ =  LEFT$(TU$,TS) +TW$
  297. 57070 TS = TZ - LEN(TW$): IF TS >0  THEN TW$ =  LEFT$(TV$,TS) +TW$
  298. 57080  IF TY >0  THEN TW$ =  LEFT$(TW$,TZ -TY) +"." + RIGHT$(TW$,TY)
  299. 57090  IF TX = 0 GOTO 57140
  300. 57100 TS = TZ: IF TY < >0  THEN TS = TZ -TY
  301. 57110 TS = TS -3: IF TS <1 GOTO 57140
  302. 57120 TS$ = ",": IF  MID$ (TW$,TS,1) = " "  THEN TS$ = " "
  303. 57130 TW$ =  LEFT$(TW$,TS) +TS$ + RIGHT$(TW$, LEN(TW$) -TS): GOTO 57110
  304. 57140 TS$ = " ": IF TW <0  THEN TS$ = "-"
  305. 57150 TW$ = TW$ +TS$: RETURN 
  306. 57160  REM =======================